#include "types.h"
#include "stdlib.h"
#include "unistd.h"
#include "sys/param.h"
#include "string.h"
#include "unified.h"
#include "builtin.h"
#include <setjmp.h>
#include "interpreter.h"
#include "gmp.h"
#include "assert.h"
#include <gc/gc.h>
#include <dlfcn.h>

/*
  Check:
  - Should arity errors fire before exceptions in arguments?
    - Probably not, but right now they do
  PRIORITIES:
  - clean up conversion and comparison
  - print pretty error messages
  - condensing type information
  - handle gmp divide by 0 (and other?) exceptions
*/

/*
  Values don't map to GMP's comparison functions
  -1 and 1 are reserved for situations where the
  operation is undefined

*/

#define CMP_LT(X) (-1 == (X))
#define CMP_LTE(X) (CMP_EQ(X) || (-1 == (X)))
#define CMP_EQ(X) (0 == (X))
#define CMP_NEQ(X) (0 != (X))
#define CMP_GT(X) (1 == (X))
#define CMP_GTE(X) (CMP_EQ(X) || (1 == (X)))
#define CMP_NOT_EQUAL 2
#define CMP_INVALID(X) (3 == X)
 
tag_t *TAG_NONE, *TAG_TRUE, *TAG_FALSE;

/*
  Work needed:
  Eliminate these macros and replace them with constants
*/

/*
#define TAG_NONE make_tag(to_unicode("none"))
#define TAG_TRUE make_tag(to_unicode("true"))
#define TAG_FALSE make_tag(to_unicode("false"))
*/

#define UNIMPLEMENTED \
  do \
  {  \
    fprintf(stderr,"Unimplemented\n"); \
    printf("%d",*(int*)0); \
  } while (0) 

/*
TO FINISH:
- Comparison
- Arithmetic
TO TEST:
- Type functions?
CONSIDER:
- When builtins file, what position do we list?
  - No knowledge of our own position
  - Position of first argument?
- Do we want bitwise functions?
- Split this file up?
  - New folders? In *my*hierarchy?!
  - It's moar likely than you think!
- We need a 'stable' hg tag once we're "stable" :D
- Capture names from def in objects? Creates better error messages?
  - How do we deal with aliasing? Tricky to find the active name
  - Set name on lookup rather than on binding? Is this a hack?
    - Might flail when threading
    - Probably a tiny edge case...do we care?
      - Yes!
      - No?
TODO:
- Move type conversion to types.c
- Sort out file structure!
- Sort parameter evaluation for builtins
  - Moar boilerplate sadfacecry
- Set hg username :)
- Define exception hierarchy
  - What's a "value" exception?
    (Valid type, wrong contents?)
- Standardise exception message format
  - Should we always refer to the function name?
  - Should we always refer to argument position?
    e.g.  Cannot take head of an empty list
            vs
          First argument of builtin 'head' must be non-empty
  - What about when we're arity 1? Does 'first' argument make sense?
  - Numeric vs English positions (argument 1 vs first)
  - Document on googlecode? :)
- Ensure full exception coverage
*/

int new_compare(value_t *a, value_t *b)
{
  if(a == b)
  {
    return 0; // Equal
  }
  else if(!comparable_types(a,b))
  {
    return 2; // Not Equal
  }

  promote(&a,&b);

  switch(get_type(a))
  {
    
  }
}

int compare_equal(value_t *a, value_t *b)
{
  if(a == b)
  {
    return 1;
  }

  type_t a_type, b_type;

  a_type = get_type(a);
  b_type = get_type(b);

  int comparison = compare(a,b);
  if(CMP_EQ(comparison))
  {
    return 1;
  }
  else
  {
    return 0;
  }

}

int compare(value_t *a, value_t *b)
{
  if(a == b)
  {
    return 0; // Shortcut
  }
 
  type_t a_type = get_type(a);
  type_t b_type = get_type(b);

  // Return here for "unique" types
/*
  if(unique(a) || unique(b))
  {
    return 1;
  }
*/
  // Special cases :(
    if((type_string == a_type) && (type_list == b_type))
  {
    return 
      !(u_strlen(a->string.value) || (b->list.items && b->list.items->length))
      ? 0
      : 2;
  }
  
  else if ((type_string == b_type) && (type_list == a_type))
  {
    return 
      !(u_strlen(b->string.value) || (a->list.items && a->list.items->length))
      ? 0
      : 2;
  }


  if(-1 == promote(&a,&b))
  {
    return 3;
  }
  
  if(a_type == b_type)
  {
    switch(a_type)
    {
      case type_integer:
        return scale_comparison(mpz_cmp(a->integer.value,b->integer.value));
      case type_float:
        return scale_comparison(mpf_cmp(a->floatt.value,b->floatt.value));
      case type_tag:
      {
        if(a == b)
        {
          return 0;
        }

        UChar *a_string = get_identifier_string(tag_get_value(a));//->tag.value);
        UChar *b_string = get_identifier_string(tag_get_value(b));//->tag.value);

        int a_length = u_strlen(a_string);
        int b_length = u_strlen(b_string);
        UBool codePointOrder = 0;

        int comparison =
          u_strCompare(a_string, a_length, b_string, b_length,
                        codePointOrder);

        return scale_comparison(comparison);
      }
      case type_string:
        {
          int a_length = u_strlen(a->string.value);
          int b_length = u_strlen(b->string.value);
          UBool codePointOrder = 0;

          int comparison =
            u_strCompare(a->string.value, a_length, b->string.value, b_length,
                          codePointOrder);

          return scale_comparison(comparison);
        }
      case type_list:
        {
          if(list_empty(a) && list_empty(b))
          {
            return 0;
          }
          else if(list_empty(a) || list_empty(b))
          {
            return 2;
          }
          else
          {
            /*item-wise comparison. are we breaking the list abstraction? */
            list_entry_t *entry_a = a->list.items->first;
            list_entry_t *entry_b = b->list.items->first;
            while(entry_a)
            {
              if(CMP_NEQ(compare((value_t*)entry_a->head,(value_t*)entry_b->head)))
              {
                return 2;
              }
              entry_a = entry_a->tail;
              entry_b = entry_b->tail;
            }
            return 0;
          }
        }
      default:
        return 3;
    }
  }
  
  return 3;
}

// Scope functions

/*
  Takes: name, value
  Returns: .none
  Exceptions: None
  
  Binds value to name in the enclosing scope. Successive definitions of the
  same name will shadow previous definitions and remain effective for the
  lifetime of the scope.
*/

value_t *builtin_def(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  name_t *name = arguments->first->head;
  value_t *value = evaluate_item(scope,arguments->first->tail->head,handler);
  
  if(!has_type(name, type_name))
    exception_at(handler, name, "type", "First argument of builtin 'def' must be a name");
  else if(name_is_lookup(name))
    exception_at(handler, name, "value", "Cannot bind multi-part names");

  bind(scope,name,value);
  
  return (value_t*)TAG_NONE;
}

/*
  Takes: function literal
  Returns: scope
  Exceptions:
    value - function is of variable arity / arity greater than 0
  
  Takes the closure of the literal function with respect to the enclosing
  scope and evaluates it, returning the resulting scope.
*/

value_t *builtin_scope(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  function_t *function = arguments->first->head;
  if(type_function != function->type)
  {
    exception_at(handler,function,"type",
      "First argument of builtin 'scope' must be a literal function");
  }
 
  scope_t *retrieve_scope;
  closure_t *closure = make_closure(scope, function);
 
  if(!has_arity((value_t*)closure,0))
  {
    exception_at(handler,closure,"value",
      "Argument of builtin 'scope' must be a function of no arguments");
  }
  
  generic_list_t *dummy = make_generic_list(NULL);
  
  call_closure(closure,dummy,0,&retrieve_scope,handler);
  
  return (value_t*)retrieve_scope;
  
}

/*
  Takes: name
  Returns: .none
  Exceptions:
    lookup - name is not bound in the enclosing scope
  
  Looks up 'name' in the enclosing scope and sets it to hidden. 'name' will no
  longer be accessible by any outer scope, either by lookup (dotted names)
  or inclusion ('use'ing the scope), for the lifetime of the enclosing scope.
*/

value_t *builtin_hide(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  /*Implement for multiple arguments later */
  name_t *name = (name_t*)arguments->first->head;
  binding_t *current_binding = scope->first;
  while(current_binding)
  {
     if(current_binding->name == name_get_value(name)) //name_equal(current_binding->name, name))
     {
       current_binding->hidden = 1;
       return (value_t*)TAG_NONE;
     }
    current_binding = current_binding->next;
  }
  exception_at(handler,"lookup", "Not found BETTER MESSAGE PLEASE");
}

/*
  Takes: filename
  Returns: scope
  Exceptions:
    file - filename could not be accessed
    syntax - the named file contains a syntax error
  
  Reads the contents of 'filename' as though they were the body of a function
  and evaluates them, returning the scope as if the file were a literal passed
  to the 'scope' builtin.
*/

#define PATH_SEPARATOR '/'

value_t *builtin_load(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
 
  /*
    Add support for machine/user "site" package directories?
    - or just : delimited MEW_PATH members
  */

  generic_list_t *concrete = evaluate_list(scope,arguments,handler);
  
  string_t *filepath = (string_t*)concrete->first->head;
  
  if(!has_type(filepath,type_string))
  {
    exception_at(handler,filepath,"type",
      "First argument of buildin 'load' must be a string");
  }  
  
	char *index;
	char *path = from_unicode(filepath->value);
	char working[MAXPATHLEN];

  void *extension = dlopen(path, RTLD_NOW);

  if(extension)
  {
    value_t *(*register_extension)() = dlsym(extension,"register_extension");
    //return register_extension();
  }

  UFILE *filehandle = u_fopen(path,"r",NULL,NULL);

	if(!filehandle)
	{

    if(PATH_SEPARATOR != path[0])
    {
      char *stdlib_path;
      if(stdlib_path = getenv("MEW_PATH"))
      {
        unsigned int lib_path_length = strlen(stdlib_path);
        unsigned int path_length = lib_path_length + 1 + strlen(path) + 1;
        char *path_buffer = GC_MALLOC(path_length);
        strcpy(path_buffer,stdlib_path);
        if(PATH_SEPARATOR != path_buffer[lib_path_length-1])
        {
          path_buffer[lib_path_length++] = PATH_SEPARATOR;
        }
        strcpy(&path_buffer[lib_path_length],path);
        path_buffer[path_length] = '\0';
  
        extension = dlopen(path_buffer, RTLD_NOW);

        if(extension)
        {
          value_t *(*register_extension)() = dlsym(extension,"register_extension");
          //return register_extension();
        }
  
        filehandle = u_fopen(path_buffer,"r",NULL,NULL);
      }
    }

    if(!filehandle)
    {
      exception_at(handler,filepath,"file", "Module not found");
    }
	}

  function_t *function;

  /*
  Need to handle exceptions escaping from the change of
  working directory
  */

	if(index = strrchr(path,PATH_SEPARATOR))
	{
		getwd(working);
    path[(int)(index - path)] = '\0';
		chdir(path);
	}

	function = (function_t*)parse(filehandle,filepath->value,handler);
  u_fclose(filehandle); 
  
	if(index)
	{
		path[(int)(index - path)] = PATH_SEPARATOR;
		chdir(working);
	}
  
  function->arguments = 0;
  
  scope_t *retrieve_scope;
  closure_t *closure = make_closure(scope, function);
  generic_list_t *dummy = make_generic_list(NULL);
  
  call_closure(closure,dummy,0,&retrieve_scope,handler);
    
  return (value_t*)retrieve_scope;
}

/*
  Takes: scope
  Returns: .none
  Exceptions: None
  
  Subsumes 'scope' into the enclosing scope, making its defined names
  accessible as if they had been defined in that scope. Existing definitions
  in the enclosing scope will be shadowed.
*/

value_t *builtin_use(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
/*
  list_entry_t *current = concrete->first;

  while(current)
  {
    scope_t *used = current->head;

    if(!has_type(used,type_scope))
    {
      exception_at(handler,used,"type",
        "First argument of builtin 'use' must be a scope");
    }
  
    use_scope(scope,used);

    current = current->tail;
  }
*/

  iterator_t *scopes = get_iterator(concrete);
  scope_t *used_scope;

  for(used_scope = (scope_t*)iterate_first(scopes);
        iterate_is_valid(scopes);
        used_scope = (scope_t*)iterate_next(scopes))
  {
    if(!has_type(used_scope,type_scope))
    {
      exception_at(handler,used_scope,"type",
        "First argument of builtin 'use' must be a scope");
    }
  
    use_scope(scope,used_scope);
  }

  return (value_t*)TAG_NONE;
}

/*
  Takes: name, value, ..., function literal
  Returns: the result of the function
  Exceptions:
    value - the function is of nonzero / variable arity
*/

value_t *builtin_let(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  scope_t *let_scope = (scope_t*)make_scope(scope, NULL, NULL, NULL);
  
  // Odd number of arguments
  // assert(arguments->length % 2);
  
  list_entry_t *name_entry = arguments->first;
  
  while(name_entry != arguments->last)
  {
    list_entry_t *value_entry = name_entry->tail;
    value_t *value = evaluate_item(let_scope,(value_t*)value_entry->head,handler);

    bind(let_scope, name_entry->head, value);
    
    name_entry = value_entry->tail;
  }
  
  function_t *function = arguments->last->head;

  //if(!has_type(function,type_function))
  if(!has_type(function,type_function))
  {
    exception_at(handler,function,"value"
      "Last argument of builtin 'let' must be a literal function");
  }

  closure_t *closure = make_closure(let_scope, function);
  
  if(!has_arity((value_t*)closure,0))
  {
    exception_at(handler,function,"arity",
      "Last argument of builtin 'let' must be a function of no arguments");
  }

  call_t *call = make_call((value_t*)closure,NULL);

  return (value_t*)tail_call(scope,call,tail,handler);
}

// Control Flow functions
value_t *builtin_if(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  
  list_entry_t *current = concrete->first;
  value_t *first = current->head;

  while(current)
  {
    if(!has_type(current->head,type_builtin) && !has_type(current->head,type_closure))
    {
      exception_at(handler, current->head, "type",
        "All conditions of builtin 'if' must be callable");
    }
    
    if(!current->tail)
    {
      exception_at(handler,current->head,"arity",
        "All conditions of builtin 'if' must have a corresponding action");
    }
    
    if(!has_type(current->tail->head,type_builtin) && !has_type(current->tail->head,type_closure))
    {
      exception_at(handler,current->tail->head,"type",
        "All actions of builtin 'if' must be callable");
    }
    
    call_t *call = make_call(current->head,make_generic_list(NULL));
    value_t *result = evaluate_call(scope,call,0,handler);
    
    
    if(CMP_EQ(compare(result,(value_t*)TAG_TRUE)))
    {
      call = make_call(current->tail->head,make_generic_list(NULL));
      return (value_t*)tail_call(scope,call,tail,handler);
    }
    
    current = current->tail->tail;
  }
  
  exception_at(handler,first,"value",
    "No condition of builtin 'if' satisfied");

  // We never reach here
  return (value_t*)0;
}

value_t *builtin_apply(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments,handler);
  
  value_t *head = concrete->first->head;
  list_t *list = concrete->first->tail->head;
    
  if(!has_type(head,type_closure) && !has_type(head,type_builtin))
  {
    exception_at(handler,head,"type",
      "First argument of builtin 'apply' must be a function");
  }
  
  if(!has_type(list,type_list) && !has_type(list,type_string))
  {
    exception_at(handler,head,"type",
      "Second argument of builtin 'apply' must be a list");
  }

  call_t *call = make_call(head,list->items);

  value_t *result = (value_t*)tail_call(scope,call,tail,handler);
  return result;
}

value_t *builtin_match(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope,arguments,handler);

  /*
    Matching is destructive, so we need a copy
  */
  value_t *item = GC_MALLOC(sizeof(value_t));
  memcpy(item,concrete->first->head,sizeof(value_t));
  item->generic.tags = generic_list_copy(item->generic.tags);

  tag_t *tag;

  if(!item->generic.tags || (0 == item->generic.tags->length))
  {
    tag = make_tag(to_unicode("none"));
  }
  else
  {
    tag = generic_list_remove(item->generic.tags);
  }

  list_entry_t *current = concrete->first->tail;
  list_entry_t *next = current->tail;

  while(current && current->tail)
  {
    tag_t *match = current->head;
    value_t *action = current->tail->head;
    
    if(!has_type(match,type_tag))
    {
      exception_at(handler,match,"type",
        "Match must match on tags this message sucks");
    }
    else if(!is_callable(action))
    {
      exception_at(handler,action,"type",
        "Match actions must be functions");
    }
    else if(!has_arity(action, 1))
    {
      exception_at(handler,action,"arity",
        "Match actions must take a single argument");
    }

    if(CMP_EQ(compare((value_t*)tag,(value_t*)match)))
    {
      call_t *call = make_call(action,make_generic_list(item));
      return (value_t*)tail_call(scope,call,tail,handler);
    }

    current = next->tail;
    if(current)
      next = current->tail;
  }

  if(current)
  {
    value_t *action = current->head;
    if(!is_callable(action))
    {
      exception_at(handler,action,"type","Match actions must be callable");
    }
    else if(!has_arity(action,2))
    {
      exception_at(handler,action,"type","Default match action must take 2 arguments");
    }

    generic_list_t *final_arguments = make_generic_list(tag);
		generic_list_add(final_arguments,item);
    call_t *call = make_call(action,final_arguments);
    return (value_t*)tail_call(scope,call,tail,handler);
  }

  exception_at(handler,item, "argument", "No matching case in match");

  return NULL;
}

value_t *builtin_try(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{  
  generic_list_t *concrete = evaluate_list(scope,arguments,handler);
  
  closure_t *body = generic_list_index(concrete,0); //(closure_t*)concrete->first->head;
  
  if(!has_type(body,type_closure))
  {
    exception_at(handler, body, "type",
      "First argument of builtin 'try' must be a function");
  }

  // The jump buffer must be heap allocated
  // - longjmp mangles the stack
  handler_t *new_handler = GC_MALLOC(sizeof(handler_t));

  new_handler->stack = make_generic_list(NULL);
  new_handler->status = setjmp(new_handler->jump);
  new_handler->handling = concrete;

  if(new_handler->status)
  {
    concrete = new_handler->handling;
    value_t *action =generic_list_index(concrete,1); //(value_t*)concrete->first->tail->head;
    if(!has_type(action,type_closure) && !has_type(action,type_builtin))
    {
      exception_at(handler, action, "type",
        "Second argument of builtin 'try' must be a function");
    }

		generic_list_t *tag_list = make_generic_list(new_handler->tag);
    generic_list_add(tag_list,new_handler->value);
		generic_list_t *rest_list = splice_generic_list(generic_list_index(concrete,1)); //concrete->first->tail);

    generic_list_t *action_arguments = generic_list_append(tag_list, rest_list);
    call_t *call = make_call(action, action_arguments);//concrete->first->tail->head, action_arguments);

    return (value_t*)tail_call(scope,call,tail,handler);
  }

  value_t *result = (value_t*)call_closure(body,make_generic_list(NULL),0,NULL,new_handler);
 
  return result;
}

value_t *builtin_throw(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  tag_t *tag = concrete->first->head;
  value_t *value = concrete->first->tail->head;
 
  if(!has_type(tag,type_tag))
  {
    exception_at(handler, tag, "type",
      "First argument of builtin 'throw' must be a tag");
  }

  handler->tag = tag;

  //generic_list_t *description = value; //value_position(value);
  //generic_list_insert(description,value);
  handler->value = value; //(value_t*)make_list(description);

  longjmp(handler->jump,1);

  // Placate the compiler
  return (value_t*)0;
}

// WORK NEEDED: Why isn't concrete used?!
value_t *builtin_catch(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope,arguments,handler);

  tag_t *tag = arguments->first->head;
  value_t *value = arguments->first->tail->head;

  list_entry_t *current = arguments->first->tail->tail;
  list_entry_t *next = current->tail;

  while(current && current->tail)
  {
    tag_t *match = current->head;
    closure_t *action = current->tail->head;
    
    if(!has_type(match,type_tag))
    {
      exception_at(handler,match,"type",
        "catch must match on tags this message sucks");
    }
    else if(!has_type(action,type_closure))
    {
      exception_at(handler,action,"type",
        "catch actions must be functions");
    }
    else if(0 /*check arity */) { }

    if(CMP_EQ(compare((value_t*)tag,(value_t*)match)))
    {
      call_t *call = make_call((value_t*)action,make_generic_list(value));
      return (value_t*)tail_call(scope,call,tail,handler);
    }

    current = next->tail;
    if(current)
      next = current->tail;
  }

  if(current)
  {
    generic_list_t *final_arguments = make_generic_list(tag);
		generic_list_add(final_arguments,value);
    call_t *call = make_call((value_t*)current->head,final_arguments);
    return (value_t*)tail_call(scope,call,tail,handler);
  }

  handler->tag = tag;
  handler->value = value;
  longjmp(handler->jump,1);

  return (value_t*)0;
}

// Type functions

/*
  Takes: A value
  Returns: Its type
  Exceptions: None
  
  Takes a value and returns its type as a symbol
*/
value_t *builtin_type(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  value_t *value = evaluate_item(scope,arguments->first->head,handler);
  
  
  tag_t *type;
  switch(get_type(value))
  {
    case type_character:
      return (value_t*)make_tag(to_unicode("character"));
    case type_string:
      return (value_t*)make_tag(to_unicode("string"));
    case type_list:
      return (value_t*)make_tag(to_unicode("list"));
    case type_closure:
    case type_builtin:
      return (value_t*)make_tag(to_unicode("function"));
    case type_integer:
      return (value_t*)make_tag(to_unicode("integer"));
    case type_float:
      return (value_t*)make_tag(to_unicode("float"));
    case type_tag:
      return (value_t*)make_tag(to_unicode("tag"));
    default:
      assert(0);
  }
}

/*
  Takes: A function
  Returns: Its arity
  Exceptions: None
  
  Takes a function (either builtin or user defined) and returns its arity.
*/

value_t *builtin_arity(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  value_t *callable = evaluate_item(scope,arguments->first->head,handler);
  
  /*
    Can't return the arity of a non-function
    Should other callables have arity? Handle builtins!
  */
  if(!(has_type(callable,type_closure)) && !(has_type(callable,type_builtin)))
  {
    exception_at(handler,callable, "type",
      "First argument of builtin 'arity' must be a function" );
  }
  
  int arity = 0;
  if(has_type(callable,type_closure))
  {
    if(callable->closure.function->arguments)
    {
      arity = callable->closure.function->arguments->length;
    }
  }
  else
  {
    arity = callable->builtin.arity;
  }
  return (value_t*)make_integer(arity);
  
}

/*
  Takes: function
  Returns: tag
  Exceptions: none
  
  Takes a function and returns a tag - .true if the function takes a
  variable number of arguments, .false otherwise.
*/

value_t *builtin_varargs(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  value_t *function = evaluate_item(scope,arguments->first->head,handler);
 
  if(has_type(function,type_closure))
  {
    return (value_t*)(((closure_t*)function)->function->tail ? TAG_TRUE : TAG_FALSE);
  }
  else if(has_type(function,type_builtin))
  {
    return (value_t*)(((builtin_t*)function)->varargs ? TAG_TRUE : TAG_FALSE);
  }
  else
  {
    exception_at(handler, function, "type",
      "First argument of builtin 'varargs?' must be a function" );
  }
  
}

/*
Promotion Rules:
// - Characters are promoted to Integers as UTF8 bytes
- Integers are promoted to floats
- Promotions are pairwise, not for whole lists
*/

/*
  Takes: list of values
  Returns: tag denoting truth/falsity
  Exceptions: None
  
  Takes a list of values of comparable types and returns .true if each is
  less than the next. Returns .false otherwise.
*/

value_t *builtin_lt(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  iterator_t *values = get_iterator(concrete);

  value_t *a = iterate_first(values);
  value_t *b;

  while(b = iterate_next(values))
  {
    int comparison = compare(a,b);
    if(CMP_GTE(comparison))
    {
      return (value_t*)TAG_FALSE;
    }
    else if(CMP_INVALID(comparison))
    {
      exception_at(handler,a,"type",
        "Arguments of builtin comparisons must be of comparable types"
        );
    }
    a = b;   
  }

  return (value_t*)TAG_TRUE;
}

/*
  Takes: list of values
  Returns: tag denoting truth/falsity
  Exceptions: None
  
  Takes a list of values of comparable types and returns .true if each is
  less than or equal to the next. Returns .false otherwise.
*/


value_t *builtin_lte(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  iterator_t *values = get_iterator(concrete);

  value_t *a = iterate_first(values);
  value_t *b;

  while(b = iterate_next(values))
  {
    int comparison = compare(a,b);
    if(CMP_GT(comparison))
    {
      return (value_t*)TAG_FALSE;
    }
    else if(CMP_INVALID(comparison))
    {
      exception_at(handler,a,"type",
        "Arguments of builtin comparisons must be of comparable types"
        );
    }
    a = b;
  }

  return (value_t*)TAG_TRUE;
}

/*
  Takes: list of values
  Returns: tag denoting truth/falsity
  Exceptions: None
  
  Takes a list of values of comparable types and returns .true if each is
  greater than the next. Returns .false otherwise.
*/

value_t *builtin_gt(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  iterator_t *values = get_iterator(concrete);
  
  value_t *a = iterate_first(values);
  value_t *b;

  while(b = iterate_next(values))
  {
    int comparison = compare(a,b);
    if(CMP_LTE(comparison))
    {
      return (value_t*)TAG_FALSE;
    }
    else if(CMP_INVALID(comparison))
    {
      exception_at(handler,a,"type",
        "Arguments of builtin comparisons must be of comparable types"
        );
    }
    a = b;
  }
  
  return (value_t*)TAG_TRUE;
}

/*
  Takes: list of values
  Returns: tag denoting truth/falsity
  Exceptions: None
  
  Takes a list of values of comparable types and returns .true if each is
  greater than or equal to the next. Returns .false otherwise.
*/


value_t *builtin_gte(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);

  iterator_t *values = get_iterator(concrete);
  
  value_t *a = iterate_first(values);
  value_t *b;

  while(b = iterate_next(values))
  { 

    int comparison = compare(a,b);
    if(CMP_LT(comparison))
    {
      return (value_t*)TAG_FALSE;
    }
    else if(CMP_INVALID(comparison))
    {
      exception_at(handler,a,"type",
        "Arguments of builtin comparisons must be of comparable types"
        );
    }
    a = b;
  }
  
  return (value_t*)TAG_TRUE;
}

/*
  Takes: list of values
  Returns: tag denoting truth/falsity
  Exceptions: None
  
  Takes a list of values of comparable types and returns .true if each is
  equal to the next. Returns .false otherwise.
*/

value_t *builtin_eq(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  iterator_t *values = get_iterator(concrete);
  
  value_t *a = iterate_first(values);
  value_t *b;

  while(b = iterate_next(values))
  { 
    if(!compare_equal(a,b))
    {
      return (value_t*)TAG_FALSE;
    }
/*
    int comparison = compare(a,b);
    if(CMP_NEQ(comparison))
    {
      return (value_t*)TAG_FALSE;
    }
    else if(CMP_INVALID(comparison))
    {
      exception_at(handler,a,"type",
        "Arguments of builtin comparisons must be of comparable types"
        );
    }
*/
    a = b;
  }
  
  return (value_t*)TAG_TRUE;
}

/*
  Takes: list of values
  Returns: tag denoting truth/falsity
  Exceptions: None
  
  Takes a list of values of comparable types and returns .true if each is
  not equal to the next. Returns .false otherwise. Note that two non-adjacent
  values may be equal and the result still be .true.
*/


value_t *builtin_neq(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  
  iterator_t *values = get_iterator(concrete);
  
  value_t *a = iterate_first(values);
  value_t *b;

  while(b = iterate_next(values))
  { 
    if(compare_equal(a,b))
    {
      return (value_t*)TAG_FALSE;
    }
    //int comparison = compare(a,b);
    //if(CMP_EQ(comparison))
    //{
    //  return (value_t*)TAG_FALSE;
    //}
    /*
    else if(CMP_INVALID(comparison))
    {
      exception_at(handler,a->head,"type",
        "Arguments of builtin comparisons must be of comparable types"
        );
    }
    */
    a = b;
  }
  
  return (value_t*)TAG_TRUE;
}

/*
  Scales the result of a GMP comparison for use by the CMP_ macros
*/

int scale_comparison(int gmp)
{
  if(0 == gmp)
    return 0;
  else if(0 < gmp)
    return 1;
  else if(0 > gmp)
    return -1;
  else
    return 2;
}

// TODO:
// *Free intermediate results
// *Fold identities (e.g. (*a 1) => a)

/*
  Takes: a list of summable values
  Returns: their sum
  Exceptions: None
  
  Performs successive pairwise addition of each list member with the result
  of the previous addition, performing type promotions as necessary. The type
  of the resulting total is that of the 'highest' type in the list.
*/

value_t *builtin_add(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  list_entry_t *current = concrete->first;
  
  value_t *result = GC_MALLOC(sizeof(value_t));
  value_t *current_value = current->head;
  ((generic_t*)result)->type = ((generic_t*)current_value)->type;

  if(has_type(current_value,type_integer))
  {
    mpz_init_set(((integer_t*)result)->value, ((integer_t*)current_value)->value);
  }
  else if(has_type(current_value,type_float))
  {
    mpf_init_set(((float_t*)result)->value, ((float_t*)current_value)->value);
  }
  else if(has_type(current_value, type_character)) 
  {
    ((character_t*)result)->value = ((character_t*)current_value)->value;
  }
  
  while(current->tail)
  {
    /*
      This will leak horrifically, fix it
    */

    value_t *next = current->tail->head;
    current = current->tail;
    int promotion = promote(&result,&next);
    
    if(-1 == promotion)
    {
      exception_at(handler,next,"type",
        "Types could not be added BETTER MESSAGE");
    }
    
    switch(get_type(result))
    {
      case type_integer:
        mpz_add(((integer_t*)result)->value,((integer_t*)result)->value,((integer_t*)next)->value);
        ((integer_t*)result)->type = type_integer;
        break;
      case type_float:
        ((float_t*)result)->type = type_float;
        mpf_add(((float_t*)result)->value,((float_t*)result)->value,((float_t*)next)->value);
        break;
      default:
        exception_at(handler,result,"type",
          "Types can't be added BETTER MESSAGE");
    }
    
  }
  
  return result;
}

/*
  Takes: a list of subtractable values
  Returns: the total of successive subtractions
  Exceptions: None
  
  Performs successive pairwise subtraction of each list member with the result
  of the previous subtraction. Types are dealt with as in addition.
*/

value_t *builtin_subtract(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  list_entry_t *current = concrete->first;
  
  value_t *result = GC_MALLOC(sizeof(value_t));
  value_t *current_value = current->head;
  ((generic_t*)result)->type = ((generic_t*)current_value)->type;
  if(has_type(current_value,type_integer))
  {
    mpz_init_set(((integer_t*)result)->value, ((integer_t*)current_value)->value);
  }
  else if(has_type(current_value,type_float))
  {
    mpf_init_set(((float_t*)result)->value, ((float_t*)current_value)->value);
  }
  else if(has_type(current_value, type_character)) 
  {
    ((character_t*)result)->value = ((character_t*)current_value)->value;
  }

  
  while(current->tail)
  {
    /*
      This will leak horrifically, fix it
    */

    value_t *next = current->tail->head;
    current = current->tail;
    int promotion = promote(&result,&next);
    
    if(-1 == promotion)
    {
      exception_at(handler,next,"type",
        "Types could not be added BETTER MESSAGE");
    }
    
    switch(get_type(result))
    {
      case type_integer:
        mpz_sub(((integer_t*)result)->value,((integer_t*)result)->value,((integer_t*)next)->value);
        ((integer_t*)result)->type = type_integer;
        break;
      case type_float:
        ((float_t*)result)->type = type_float;
        mpf_sub(((float_t*)result)->value,((float_t*)result)->value,((float_t*)next)->value);
        break;
      default:
        exception_at(handler,result,"type",
          "Types can't be added BETTER MESSAGE");
    }
    
  }
  
  return result;
}

/*
  Takes: a list of multipliable values
  Returns: their product
  Exceptions: None
  
  Performs successive pairwise multiplication of each list member with the
  resultof the previous multiplication. Types are dealt with as in addition.
*/

value_t *builtin_multiply(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  list_entry_t *current = concrete->first;
  
  value_t *result = GC_MALLOC(sizeof(value_t));
  value_t *current_value = current->head;
  ((generic_t*)result)->type = ((generic_t*)current_value)->type;
  if(has_type(current_value,type_integer))
  {
    mpz_init_set(((integer_t*)result)->value, ((integer_t*)current_value)->value);
  }
  else if(has_type(current_value,type_float))
  {
    mpf_init_set(((float_t*)result)->value, ((float_t*)current_value)->value);
  }
  else if(has_type(current_value,type_character))
  {
    ((character_t*)result)->value = ((character_t*)current_value)->value;
  }


  
  while(current->tail)
  {
    /*
      This will leak horrifically, fix it
    */

    value_t *next = current->tail->head;
    current = current->tail;
    int promotion = promote(&result,&next);
    
    if(-1 == promotion)
    {
      exception_at(handler,next,"type",
        "Types could not be added BETTER MESSAGE");
    }
    
    switch(get_type(result))
    {
      case type_integer:
        mpz_mul(((integer_t*)result)->value,((integer_t*)result)->value,((integer_t*)next)->value);
        ((integer_t*)result)->type = type_integer;
        break;
      case type_float:
        ((float_t*)result)->type = type_float;
        mpf_mul(((float_t*)result)->value,((float_t*)result)->value,((float_t*)next)->value);
        break;
      default:
        exception_at(handler,result,"type",
          "Types can't be added BETTER MESSAGE");
    }
    
  }
  
  return result;

}

/*
  Takes: a list of dividable values
  Returns: the result of successive divisions
  Exceptions: None
  
  Performs successive pairwise division of each list member with the result
  of the previous divison. Types are dealt with as in addition.
*/

value_t *builtin_divide(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  list_entry_t *current = concrete->first;
  
  value_t *result = GC_MALLOC(sizeof(value_t));
  value_t *current_value = current->head;
  ((generic_t*)result)->type = ((generic_t*)current_value)->type;
  if(has_type(current_value,type_integer))
  {
    mpz_init_set(((integer_t*)result)->value, ((integer_t*)current_value)->value);
  }
  else if(type_float == ((generic_t*)current_value)->type)
  {
    mpf_init_set(((float_t*)result)->value, ((float_t*)current_value)->value);
  }
  else if(type_character == ((generic_t*)current_value)->type)
  {
    ((character_t*)result)->value = ((character_t*)current_value)->value;
  }

  
  while(current->tail)
  {
    /*
      This will leak horrifically, fix it
    */

    value_t *next = current->tail->head;
    current = current->tail;
    int promotion = promote(&result,&next);
    
    if(-1 == promotion)
    {
      exception_at(handler,next,"type",
        "Types could not be added BETTER MESSAGE");
    }
    
    switch(get_type(result))
    {
      case type_integer:
        if(mpz_divisible_p(((integer_t*)result)->value,((integer_t*)next)->value))
        {
          mpz_divexact(((integer_t*)result)->value,((integer_t*)result)->value,((integer_t*)next)->value);
          ((integer_t*)result)->type = type_integer;
          break;
        }
        result = (value_t*)integer_to_float((integer_t*)result);
        next = (value_t*)integer_to_float((integer_t*)next);
      case type_float:
        ((float_t*)result)->type = type_float;
        mpf_div(((float_t*)result)->value,((float_t*)result)->value,((float_t*)next)->value);
        break;
      default:
        exception_at(handler,result,"type",
          "Types can't be added BETTER MESSAGE");
    }
    
  }
  
  return result;

}

/*
  Takes: a list of dividable values
  Returns: the result of successive remainders
  Exceptions: None
  
  Takes the pairwise remainder of each list member with the result
  of the previous operation. Types are dealt with as in addition.
*/

value_t *builtin_mod(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
    generic_list_t *concrete = evaluate_list(scope, arguments, handler);

    list_entry_t *current = concrete->first;

    integer_t *result = GC_MALLOC(sizeof(integer_t));
    value_t *current_value = current->head;
    ((generic_t*)result)->type = type_integer;
    if(type_integer == ((generic_t*)current_value)->type)
    {
      mpz_init_set(((integer_t*)result)->value, ((integer_t*)current_value)->value);
    }
    else if(type_float == ((generic_t*)current_value)->type)
    {
      mpz_init(result->value);
      mpz_set_f(result->value, ((float_t*)current_value)->value);
    }
    else if(type_character == ((generic_t*)current_value)->type)
    {
      ((character_t*)result)->value = ((character_t*)current_value)->value;
    }
    else
    {
      exception_at(handler,current_value,"type",
        "Type can't be converted to an int lol these messages suck \\o/");
    }

    while(current->tail)
    {
      /*
        This will leak horrifically, fix it
      */

      value_t *next = current->tail->head;
      current = current->tail;

      switch(get_type(next))
      {
        case type_float:
          next = (value_t*)float_to_integer((float_t*)next);
        case type_integer:
          mpz_mod(result->value,result->value,((integer_t*)next)->value);
          break;
        default:
          exception_at(handler,next,"type",
            "Types can't be added BETTER MESSAGE");
      }

    }

    return (value_t*)result;

}

/*
  Takes: a list of dividable values
  Returns: the result of successive truncating divisions
  Exceptions: None
  
  Performs successive pairwise truncating division of each list member with
  the result of the previous subtraction. Types are dealt with as in addition.
*/
value_t *builtin_div(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler) {
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);

  list_entry_t *current = concrete->first;

  integer_t *result = GC_MALLOC(sizeof(integer_t));
  value_t *current_value = current->head;
  ((generic_t*)result)->type = type_integer;
  if(type_integer == ((generic_t*)current_value)->type)
  {
    mpz_init_set(((integer_t*)result)->value, ((integer_t*)current_value)->value);
  }
  else if(type_float == ((generic_t*)current_value)->type)
  {
    mpz_init(result->value);
    mpz_set_f(result->value, ((float_t*)current_value)->value);
  }
  else if(type_character == ((generic_t*)current_value)->type)
  {
    ((character_t*)result)->value = ((character_t*)current_value)->value;
  }
  else
  {
    exception_at(handler,current_value,"type",
      "Type can't be converted to an int lol these messages suck \\o/");
  }

  while(current->tail)
  {
    /*
      This will leak horrifically, fix it
    */

    value_t *next = current->tail->head;
    current = current->tail;

    switch(get_type(next))
    {
      case type_float:
        next = (value_t*)float_to_integer((float_t*)next);
      case type_integer:
        mpz_tdiv_q(result->value,result->value,((integer_t*)next)->value);
        break;
      default:
        exception_at(handler,next,"type",
          "Types can't be added BETTER MESSAGE");
    }

  }

  return (value_t*)result;
}

// TODO:
// *Identify places where an empty list isn't a null pointer
// *Convert strings to ropes

/*
  Takes: a non-empty list
  Returns: its first item
  Exceptions:
    value - list is empty
  
  Takes a non-empty list and returns its first item.
*/
value_t *builtin_head(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  list_t *list = (list_t*)evaluate_item(scope,arguments->first->head,handler);
  
  string_t *string;
  if(has_type(list,type_list))
  {
    if(!list->items)
    {
      /*Can't take the head of an empty list */
      exception_at(handler, list, "value",
        "Cannot take the head of an empty list");
    }
    // Return the first item of the list
    return list->items->first->head;
  }
  else if(has_type(list,type_string))
  {
    string = (string_t*)list;
    if(!(string->value && u_strlen(string->value)))
    {
      exception_at(handler, list, "value",
        "Cannot take the head of an empty string");
    }
    // Assert length is non-zero somehow
    // Depends on port to ICU.
    return (value_t*)make_character(*(string->value));
  }
  else
  {
    exception_at(handler, list, "type",
      "First argument of builtin 'head' must be a list or string");
  }
}

/*
  Takes: a non-empty list
  Returns: all elements but the first
  Exceptions:
    value - list is empty
  
  Takes a non-empty list and returns a list containing all items but its first
*/

value_t *builtin_tail(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  list_t *list = (list_t*)evaluate_item(scope,arguments->first->head, handler);
  
  
  string_t *string;

  if(has_type(list,type_list))
  {
		list_t *tail;
    if(!list->items)
    {
      /*Can't take the tail of an empty list */
      exception_at(handler, list, "value",
        "Cannot take the tail of an empty string");
    }
		else if(1 == list->items->length)
		{
			tail = make_list(NULL);
		}
		else
		{
			tail = make_list(splice_generic_list(list->items->first->tail));
		}
    // Return the tail of the list
    return (value_t*)tail;
  }
  else if(has_type(list,type_string))
  {
    // Assert length is non-zero somehow
    // Depends on port to ICU.
    string = (string_t*)list;
    if(!(string->value && u_strlen(string->value)))
    {
      exception_at(handler, string, "value",
        "Cannot take the tail of an empty string");
    }
    return (value_t*)make_string(string->value+1);
  }
  else
  {
    exception_at(handler, list, "type",
      "First argument of builtin 'tail' must be a list or string");
  }
}

/*
  Takes: a list
  Returns: its length
  Exceptions: None
  
  Takes a list and returns the number of items it contains. Note that nested
  lists are taken to be a single item.
*/

value_t *builtin_length(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  list_t *list = (list_t*)evaluate_item(scope,arguments->first->head, handler);
  string_t *string;
  
  
  if(has_type(list,type_list))
  {
    if(!list->items)
      return (value_t*)make_integer(0);
    return (value_t*)make_integer(list->items->length);
  }
  else if(has_type(list,type_string))
  {
    string = (string_t*)list;
    if(!string->value)
      return (value_t*)make_integer(0);
    return (value_t*)make_integer(u_strlen(string->value));
  }
  else
    exception_at(handler, list, "type",
      "First argument of builtin 'length' must be a list or string");
}

// Reference functions

/*
  Takes: reference, value
  Returns: .none
  Exceptions: None
  
  Updates 'reference' to contain 'value'
*/

value_t *builtin_set(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  reference_t *reference = concrete->first->head;
  value_t *value = concrete->first->tail->head;
  
  if(!has_type(reference,type_reference))
  {
    exception_at(handler, reference, "type",
      "First argument of builtin 'set' must be a reference");
  }
  
  reference->value = value;
  return value;
}

/*
  Takes: reference
  Returns: value
  Exceptions: None
  
  Returns the value held in 'reference'
*/

value_t *builtin_get(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  reference_t *reference = (reference_t*)evaluate_item(scope,arguments->first->head, handler);
  
  if(!has_type(reference,type_reference))
  {
    exception_at(handler, reference, "type",
      "First argument of builtin 'get' must be a reference");
  }
  
  return reference->value;
}

/*
  Takes: value
  Returns: .none
  Exceptions: None
  
  Returns a reference containing 'value'
*/

value_t *builtin_reference(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  value_t *value = evaluate_item(scope,arguments->first->head,handler);
  
  return (value_t*)make_reference(value);
}

/*
  Takes: Optional prompt string
  Returns: string
  Exceptions:
    file - end of stream?
  
  Prints the prompt string if given and returns the string value entered by
  the user.
*/

value_t *builtin_input(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  value_t *argument = evaluate_item(scope,arguments->first->head,handler);
  
  UFILE *u_stdout = u_finit(stdout,NULL,NULL);
  UFILE *u_stdin = u_finit(stdin,NULL,NULL);
  UChar *prompt;
  if(has_type(argument,type_string))
  {
    prompt = argument->string.value;
  }
  else
  {
    prompt = show_value(argument);
  }
  u_fprintf(u_stdout,"%S",prompt);
  // Magic number alert
  size_t buffer_size = 1024;
  UChar *string_buffer = GC_MALLOC(buffer_size*sizeof(UChar));
  u_fgets(string_buffer,buffer_size,u_stdin);
  int string_length = u_strlen(string_buffer);
  string_buffer[string_length-1] = 0;
  string_t *input = make_string(string_buffer);
  u_fclose(u_stdin);
  u_fclose(u_stdout);
  return (value_t*)input;
}

/*
  Takes: a list of printable values
  Returns: .none
  Excetpions: None
  
  Prints the list of values in their canonical form, interspersed with spaces.
*/

UChar *show_value(value_t*value);

value_t *builtin_print(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  generic_list_t *concrete = evaluate_list(scope, arguments, handler);
  
  list_entry_t *current = concrete->first;
  value_t *argument = current->head;
  UFILE *u_stdout = u_finit(stdout,NULL,NULL);

  if(has_type(argument,type_string))
  {
    u_fprintf(u_stdout,"%S",argument->string.value);
  }
  else
  {
    UChar *string = show_value(argument);
    u_fprintf(u_stdout,"%S",string);
  }

  current = current->tail;

  while(current)
  {
    argument = current->head;

    if(has_type(argument,type_string))
    {
      u_fprintf(u_stdout," %S",argument->string.value);
    }
    else
    {
      UChar *string = show_value(argument);
      u_fprintf(u_stdout," %S",string);
    }

    current = current->tail;
  }

  u_fprintf(u_stdout, "\n");
  u_fflush(u_stdout);
  u_fclose(u_stdout);

  return (value_t*)TAG_NONE;
}

/*
  Takes: value
  Returns: string
  Exceptions: None
  
  Returns the canonical representation of the provided value as a string.
*/

value_t *builtin_show(generic_list_t *arguments, scope_t *scope, int tail, handler_t *handler)
{
  value_t *argument = evaluate_item(scope,arguments->first->head,handler);
  
  UChar *string;
  if(has_type(argument,type_string)) 
  {
    string = argument->string.value;
  }
  else
  {
    string = show_value(argument);
  }
  return (value_t*)make_string(string);
}

scope_t *construct_builtins()
{
  scope_t *builtins = (scope_t*)allocate_type(type_scope);
  
  builtins->parent = 0;
  
  // Scope functions
  register_builtin(builtins, "def", &builtin_def, 2, 0);
  register_builtin(builtins, "scope", &builtin_scope, 1, 0);
  register_builtin(builtins, "hide", &builtin_hide, 1, 1);
  register_builtin(builtins, "load", &builtin_load, 1, 0);
  register_builtin(builtins, "use", &builtin_use, 1, 1);
  register_builtin(builtins, "let", &builtin_let, 3, 1);
  
  // Control Flow functions
  register_builtin(builtins, "if", &builtin_if, 4, 1);
  register_builtin(builtins, "apply", &builtin_apply, 2, 0);
  register_builtin(builtins, "match", &builtin_match, 2, 1);
  register_builtin(builtins, "try", &builtin_try, 2, 1);
  register_builtin(builtins, "throw", &builtin_throw, 2, 0);
  register_builtin(builtins, "catch", &builtin_catch, 1, 1);
  
  // Type functions
  register_builtin(builtins, "type", &builtin_type, 1, 0);
  register_builtin(builtins, "arity", &builtin_arity, 1, 0);
  register_builtin(builtins, "varargs?", &builtin_varargs, 1, 0);
  
  // Comparison functions
  register_builtin(builtins, "<", &builtin_lt, 2, 1);
  register_builtin(builtins, "<=", &builtin_lte, 2, 1);
  register_builtin(builtins, ">", &builtin_gt, 2, 1);
  register_builtin(builtins, ">=", &builtin_gte, 2, 1);
  register_builtin(builtins, "=", &builtin_eq, 2, 1);
  register_builtin(builtins, "!=", &builtin_neq, 2, 1);
  
  // Arithmetic functions
  register_builtin(builtins, "+", &builtin_add, 2, 1);
  register_builtin(builtins, "-", &builtin_subtract, 2, 1);
  register_builtin(builtins, "*", &builtin_multiply, 2, 1);
  register_builtin(builtins, "/", &builtin_divide, 2, 1);
  register_builtin(builtins, "div", &builtin_div, 2, 1);
  register_builtin(builtins, "mod", &builtin_mod, 2, 1);
  
  // List functions
  register_builtin(builtins, "head", &builtin_head, 1, 0);
  register_builtin(builtins, "tail", &builtin_tail, 1, 0);
  register_builtin(builtins, "length", &builtin_length, 1, 0);
  
  // Reference functions
  register_builtin(builtins, "set", &builtin_set, 2, 0);
  register_builtin(builtins, "get", &builtin_get, 1, 0);
  register_builtin(builtins, "reference", &builtin_reference, 1, 0);
  
  // I/O functions
  register_builtin(builtins, "input", &builtin_input, 0, 1);
  register_builtin(builtins, "print", &builtin_print, 1, 1);
  register_builtin(builtins, "show", &builtin_show, 1, 0);

	TAG_NONE = make_tag(to_unicode("none"));
  TAG_TRUE = make_tag(to_unicode("true"));
  TAG_FALSE = make_tag(to_unicode("false"));

	bind(builtins,make_name(
		to_unicode("else")),
		(value_t*)
		make_closure(
			builtins,
			make_function(NULL,NULL,
				make_generic_list(
					make_call((value_t*)TAG_TRUE,NULL)
				)
			)
		)
	);

  return builtins;
}
